home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / clockelems.mod (.txt) < prev    next >
Oberon Text  |  1996-08-11  |  7KB  |  198 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. MODULE ClockElems; (* gri 18.3.91 *)    (* mod CAS 8-Jul-91 *)
  6.     See, and update if necessary the history at the bottom of the file.
  7.     IMPORT Texts, TextFrames, TextPrinter, Math, Oberon, Display, Printer, Viewers, Files, Input;
  8.     CONST
  9.         Rmin = 12; Rdef = 32; (* clock radi in pixels *)
  10.     TYPE
  11.         Time = RECORD sec, min, hour: INTEGER; timeStamp: LONGINT END;
  12.         Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
  13.         NotifyMsg = RECORD(Display.FrameMsg) END;
  14.         sin, cos: ARRAY 60 OF REAL;
  15.         old, new: Time;
  16.         Task: Oberon.Task;
  17.         Line: PROCEDURE(x1, y1, x2, y2, color, mode: INTEGER); (* current output procedure *)
  18.         Circle: PROCEDURE(x0, y0, r, color, mode: INTEGER); (* current output procedure *)
  19. (* initialization *)
  20.     PROCEDURE Init;
  21.         VAR i: INTEGER;
  22.     BEGIN i := 0;
  23.         WHILE i < 60 DO
  24.             sin[i] := Math.sin(2 * Math.pi / 60 * i);
  25.             cos[i] := Math.cos(2 * Math.pi / 60 * i);
  26.             INC(i)
  27.         END
  28.     END Init;
  29.     PROCEDURE GetTime(VAR time: Time);
  30.         VAR t, d: LONGINT;
  31.     BEGIN
  32.         Oberon.GetClock(t, d);
  33.         time.sec := SHORT(t MOD 64);
  34.         time.min := SHORT(t DIV 64 MOD 64);
  35.         time.hour := SHORT(t DIV (64*64))*5 + time.min DIV 12;
  36.         time.timeStamp := t
  37.     END GetTime;
  38. (* graphics *)
  39.     PROCEDURE* SCircle(x0, y0, r, color, mode: INTEGER);
  40.         VAR x, y, dx, dy, d: INTEGER;
  41.         PROCEDURE Dot4(x1, x2, y1, y2, color, mode: INTEGER);
  42.         BEGIN
  43.             Display.Dot(color, x1, y1, mode);
  44.             Display.Dot(color, x1, y2, mode);
  45.             Display.Dot(color, x2, y1, mode);
  46.             Display.Dot(color, x2, y2, mode)
  47.         END Dot4;
  48.     BEGIN
  49.         x := r; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1-4*r;
  50.         WHILE x > y DO
  51.             Dot4(x0-x, x0+x, y0-y, y0+y, color, mode);
  52.             Dot4(x0-y, x0+y, y0-x, y0+x, color, mode);
  53.             INC(d, dy); INC(dy, 8); INC(y);
  54.             IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  55.         END;
  56.         IF x = y THEN Dot4(x0-x, x0+x, y0-y, y0+y, color, mode) END
  57.     END SCircle;
  58.     PROCEDURE* SLine(x1, y1, x2, y2, color, mode: INTEGER);
  59.         VAR x, y, dx, dy, d, inc: INTEGER;
  60.     BEGIN
  61.         IF (y2-y1) < (x1-x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  62.         dx := 2*(x2-x1);
  63.         dy := 2*(y2-y1);
  64.         x := x1; y := y1; inc := 1;
  65.         IF dy > dx THEN
  66.             d := dy DIV 2;
  67.             IF dx < 0 THEN inc := -1; dx := -dx END;
  68.             WHILE y <= y2 DO
  69.                 Display.Dot(color, x, y, mode);
  70.                 INC(y); DEC(d, dx);
  71.                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  72.             END
  73.         ELSE
  74.             d := dx DIV 2;
  75.             IF dy < 0 THEN inc := -1; dy := -dy END;
  76.             WHILE x <= x2 DO
  77.                 Display.Dot(color, x, y, mode);
  78.                 INC(x); DEC(d, dy);
  79.                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  80.             END
  81.         END
  82.     END SLine;
  83.     PROCEDURE* PCircle(x0, y0, r, color, mode: INTEGER);
  84.     BEGIN Printer.Circle(x0, y0, r)
  85.     END PCircle;
  86.     PROCEDURE* PLine(x1, y1, x2, y2, color, mode: INTEGER);
  87.     BEGIN Printer.Line(x1, y1, x2, y2)
  88.     END PLine;
  89. (* view update *)
  90.     PROCEDURE Line2(ang: INTEGER; x0, y0, r1, r2, color: INTEGER);
  91.         VAR x1, y1, x2, y2: INTEGER;
  92.     BEGIN
  93.         ang := (15-ang) MOD 60;
  94.         x1 := SHORT(ENTIER(r1*cos[ang] + 0.5));
  95.         y1 := SHORT(ENTIER(r1*sin[ang] + 0.5));
  96.         x2 := SHORT(ENTIER(r2*cos[ang] + 0.5));
  97.         y2 := SHORT(ENTIER(r2*sin[ang] + 0.5));
  98.         Line(x0+x1, y0+y1, x0+x2, y0+y2, color, Display.invert)
  99.     END Line2;
  100.     PROCEDURE Draw(VAR time: Time; x0, y0, r, color: INTEGER);
  101.         VAR rh, rm, rs, i: INTEGER;
  102.     BEGIN
  103.         IF r >= Rmin THEN
  104.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11; i := 0;
  105.             WHILE i < 60 DO Line2(i, x0, y0, rm, r, color); INC(i, 5) END;
  106.             Line2(time.sec, x0, y0, rm-r, rs, color);
  107.             Line2(time.min, x0, y0, 0, rm, color);
  108.             Line2(time.hour, x0, y0, 0, rh, color);
  109.             Circle(x0, y0, 2, color, Display.replace)
  110.         END;
  111.         Circle(x0, y0, r, color, Display.replace)
  112.     END Draw;
  113.     PROCEDURE Update(VAR old, new: Time; x0, y0, r, color: INTEGER);
  114.         VAR rh, rm, rs: INTEGER;
  115.     BEGIN
  116.         IF r >= Rmin THEN
  117.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11;
  118.             IF old.sec # new.sec THEN Line2(old.sec, x0, y0, rm-r, rs, color); Line2(new.sec, x0, y0, rm-r, rs, color) END;
  119.             IF old.min # new.min THEN Line2(old.min, x0, y0, 0, rm, color); Line2(new.min, x0, y0, 0, rm, color) END;
  120.             IF old.hour # new.hour THEN Line2(old.hour, x0, y0, 0, rh, color); Line2(new.hour, x0, y0, 0, rh, color) END;
  121.         END
  122.     END Update;
  123. (* methods *)
  124.     PROCEDURE* HandleFrame(F: Display.Frame; VAR M: Display.FrameMsg);
  125.         VAR r: INTEGER;
  126.     BEGIN
  127.         IF M IS NotifyMsg THEN Line := SLine; Circle := SCircle; r := F.W DIV 2;
  128.             Update(old, new, F.X+r, F.Y+r, r, F(Frame).col)
  129.         ELSIF M IS Oberon.InputMsg THEN
  130.             WITH M: Oberon.InputMsg DO
  131.                 IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
  132.             END
  133.         END
  134.     END HandleFrame;
  135.     PROCEDURE* HandleElem(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  136.         VAR e: Texts.Elem; f: Frame; r: INTEGER; ch: CHAR;
  137.     BEGIN
  138.         IF msg IS TextFrames.DisplayMsg THEN
  139.             WITH msg: TextFrames.DisplayMsg DO
  140.                 IF ~msg.prepare THEN
  141.                     Line := SLine; Circle := SCircle; r := SHORT((E.W DIV TextFrames.Unit - 1) DIV 2);
  142.                     Draw(new, msg.X0+r, msg.Y0+r, r, msg.col);
  143.                     NEW(f); f.X := msg.X0; f.Y := msg.Y0; f.W := 2*r + 1; f.H := f.W;
  144.                     f.handle := HandleFrame; f.col := msg.col;
  145.                     msg.elemFrame := f
  146.                 END
  147.             END
  148.         ELSIF msg IS TextPrinter.PrintMsg THEN
  149.             WITH msg: TextPrinter.PrintMsg DO
  150.                 IF ~msg.prepare THEN
  151.                     Line := PLine; Circle := PCircle; r := SHORT((E.W DIV TextPrinter.Unit - 1) DIV 2);
  152.                     Draw(new, msg.X0+r, msg.Y0+r, r, msg.col)
  153.                 END
  154.             END
  155.         ELSIF msg IS Texts.CopyMsg THEN
  156.             NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
  157.         ELSIF msg IS Texts.IdentifyMsg THEN
  158.             WITH msg: Texts.IdentifyMsg DO
  159.                 msg.mod := "ClockElems"; msg.proc := "New"
  160.             END
  161.         ELSIF msg IS Texts.FileMsg THEN
  162.             WITH msg: Texts.FileMsg DO
  163.                 IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
  164.                 ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
  165.                 END
  166.             END
  167.         END
  168.     END HandleElem;
  169.     PROCEDURE* Clock;
  170.         VAR msg: NotifyMsg;
  171.     BEGIN
  172.         old := new; GetTime(new);
  173.         IF old.timeStamp # new.timeStamp THEN Task.time := Input.Time()+Input.TimeUnit; (*wakeup in a second *)
  174.             Viewers.Broadcast(msg)
  175.         ELSE Task.time := Input.Time() + Input.TimeUnit DIV 100; (* synchronization: wakeup in a 1/100th second *)
  176.         END
  177.     END Clock;
  178. (* commands *)
  179.     PROCEDURE New*;
  180.     BEGIN NEW(Texts.new); Texts.new.handle := HandleElem
  181.     END New;
  182.     PROCEDURE Insert*;
  183.         VAR S: Texts.Scanner; w: LONGINT; E: Texts.Elem; M: TextFrames.InsertElemMsg;
  184.     BEGIN
  185.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  186.         IF (S.line = 0) & (S.class = Texts.Int) & (S.i > 0) THEN w := (2*S.i+1)*Display.Unit
  187.         ELSE w := (2*Rdef+1)*Display.Unit
  188.         END;
  189.         NEW(E); E.W := w; E.H := w; E.handle := HandleElem;
  190.         M.e := E; Viewers.Broadcast(M)
  191.     END Insert;
  192. BEGIN
  193.     Init; GetTime(new);
  194.     NEW(Task); Task.safe := TRUE; Task.time := 0; Task.handle := Clock; Oberon.Install(Task)
  195. END ClockElems.
  196. Date    Author    Modification
  197. 1996-08-04    claudio@dial.eunet.ch    First unified version.
  198.